VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Filter"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private Bound As Integer
Private Kernel() As Single
Private Wgt As Single

' ************************************************
' Apply the filter to an array of bits.
' ************************************************
Public Sub ApplyFilter(from_pict As Object, to_pict As Object, show_progress As Boolean)
Dim bm As BITMAP
Dim hbm As Integer
Dim status As Long
Dim bytesin() As Byte
Dim bytesout() As Byte
Dim wid As Long
Dim hgt As Long
Dim i As Integer
Dim j As Integer

Dim hPal As Integer
Dim palentry(0 To 255) As PALETTEENTRY
Dim X As Integer
Dim Y As Integer
Dim r As Long
Dim g As Long
Dim b As Long

    ' *****************************
    ' * Get the input bitmap data *
    ' *****************************
    ' Get a handle to the input bitmap.
    hbm = from_pict.Image
    
    ' See how big it is.
    status = GetObject(hbm, BITMAP_SIZE, bm)
    wid = bm.bmWidthBytes
    hgt = bm.bmHeight
    
    ' Get the bits.
    ReDim bytesin(0 To wid - 1, 0 To hgt - 1)
    status = GetBitmapBits(hbm, wid * hgt, bytesin(0, 0))
    ReDim bytesout(0 To wid - 1, 0 To hgt - 1)
    
    ' ********************
    ' * Apply the filter *
    ' ********************
    ' Get the current color values.
    hPal = from_pict.Picture.hPal
    i = GetPaletteEntries(hPal, 0, 255, palentry(0))

    ' Compute the new color values.
    For X = Bound To wid - 1 - Bound
        ' If the operation has been canceled, stop.
        DoEvents
        If Not OperationRunning Then Exit For
        
        ' If we should show progress, do so.
        If show_progress Then
            status = SetBitmapBits(to_pict.Image, wid * hgt, bytesout(0, 0))
            to_pict.Refresh
        End If
        
        For Y = Bound To hgt - 1 - Bound
            r = 0
            g = 0
            b = 0
            For i = -Bound To Bound
                For j = -Bound To Bound
                    With palentry(bytesin(X + i, Y + j))
                        r = r + Kernel(i, j) * .peRed
                        g = g + Kernel(i, j) * .peGreen
                        b = b + Kernel(i, j) * .peBlue
                    End With
                Next j
            Next i
            r = r / Wgt
            g = g / Wgt
            b = b / Wgt
            If r < 0 Then r = 0
            If g < 0 Then g = 0
            If b < 0 Then b = 0
            bytesout(X, Y) = GetNearestPaletteIndex( _
                hPal, RGB(r, g, b) + &H2000000)
        Next Y
    Next X
    
    ' **********************
    ' * Display the output *
    ' **********************
    status = SetBitmapBits(to_pict.Image, wid * hgt, bytesout(0, 0))
    to_pict.Refresh
End Sub




' ************************************************
' Initialize a high pass (sharpening) filter.
' ************************************************
Public Sub InitializeHighPass(size As Integer)
Dim r As Integer
Dim c As Integer
Dim vr As Integer

    Bound = size \ 2
    ReDim Kernel(-Bound To Bound, -Bound To Bound)
    
    For r = -Bound To Bound
        vr = Bound + 1 - Abs(r)
        For c = -Bound To Bound
            Kernel(r, c) = vr * (Bound + 1 - Abs(c))
            Wgt = Wgt + Kernel(r, c)
        Next c
    Next r
End Sub

' ************************************************
' Initialize a low pass (blurring) filter.
' ************************************************
Public Sub InitializeLowPass(size As Integer)
Dim r As Integer
Dim c As Integer
Dim vr As Integer

    Bound = size \ 2
    ReDim Kernel(-Bound To Bound, -Bound To Bound)
    
    For r = -Bound To Bound
        vr = Bound + 1 - Abs(r)
        For c = -Bound To Bound
            Kernel(r, c) = vr * (Bound + 1 - Abs(c))
            Wgt = Wgt + Kernel(r, c)
        Next c
    Next r
End Sub


